Monster Media 1996 #14/Monster Media No. 14 (April 1996) (Monster Media, Inc.).ISO/prog_bas/mdbguru.zip/TRUEVS.FRT

Text File | 1995-02-25 | 8KB | 266 lines

VERSION 2.00
Begin Form <<formname>>
   Caption         =   "<<caption>>"
   ClientHeight    =   6255
   ClientLeft      =   1185
   ClientTop       =   1575
   ClientWidth     =   9420
   Height          =   6660
   Left            =   1125
   MDIChild        =   -1  'True
   ScaleHeight     =   6255
   ScaleWidth      =   9420
   Tag             =   "<<formname>>"
   Top             =   1230
   Width           =   9540
   Begin Data dtaCtr
      Caption         =   "<<formname>>"
      Connect         =   "<<connectstring>>"
      DatabaseName    =   "<<database>>"
      Exclusive       =   0   'False
      Height          =   270
      Left            =   5280
      Options         =   0
      ReadOnly        =   0   'False
      RecordSource    =   "<<recordsource>>"
      Top             =   60
      Visible         =   0   'False
      Width           =   3000
   End
   Begin VideoSoftElastic VSElastic1
      Align           =   5  'Fill Container
      AutoSizeChildren=   1  'Even Horizontal
      BevelInner      =   0  'None
      BevelOuter      =   0  'None
      Height          =   6255
      IntBkg          =   &H00C0C0C0&
      Left            =   0
      TabIndex        =   21
      Top             =   0
      Width           =   9420
      Begin VideoSoftIndexTab tab<<formname>>
         BackSheets      =   0  'None
         Caption         =   "Browse|Details"
         FontBold        =   0   'False
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   8.25
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         FrontTabColor   =   &H00C0C0C0&
         Height          =   6075
         Left            =   90
         New3D           =   -1  'True
         Position        =   0  'Top
         Style           =   7  'Straight 3D
         TabIndex        =   22
         Top             =   90
         Width           =   9240
         Begin VideoSoftElastic VSElastic4
            AutoSizeChildren=   1  'Even Horizontal
            BevelOuter      =   0  'None
            Height          =   5730
            IntBkg          =   &H00C0C0C0&
            Left            =   12330
            TabIndex        =   0
            Top             =   315
            Width           =   9180
         End
         Begin VideoSoftElastic VSElastic3
            AccessKey       =   -1  'True
            BevelOuter      =   0  'None
            CaptionPos      =   6  'Right Top
            CaptionStyle    =   4  'Inset Light
            FontBold        =   0   'False
            FontItalic      =   0   'False
            FontName        =   "MS Sans Serif"
            FontSize        =   8.25
            FontStrikethru  =   0   'False
            FontUnderline   =   0   'False
            Height          =   5730
            IntBkg          =   &H00C0C0C0&
            Left            =   12255
            TabIndex        =   24
            TagWidth        =   1500
            Top             =   315
            Width           =   9180
            <<fieldcontrols>>
         End
         Begin VideoSoftElastic VSElastic2
            AutoSizeChildren=   1  'Even Horizontal
            BevelOuter      =   0  'None
            Height          =   5730
            IntBkg          =   &H00C0C0C0&
            Left            =   30
            TabIndex        =   23
            Top             =   315
            Width           =   9180
            Begin TrueGrid tbl<<formname>>
               AllowArrows     =   -1  'True
               AllowTabs       =   -1  'True
               BackColor       =   &H0080FFFF&
               DataSource      =   "dtaCtr"
               Editable        =   -1  'True
               EditDropDown    =   -1  'True
               ExposeCellMode  =   0  'Expose upon selection
               FetchMode       =   0  'By cell
               FontBold        =   0   'False
               FontItalic      =   0   'False
               FontName        =   "MS Sans Serif"
               FontSize        =   8.25
               FontStrikethru  =   0   'False
               FontUnderline   =   0   'False
               HeadingHeight   =   1
               Height          =   5550
               HorzLines       =   2  '3D
               LayoutIndex     =   1
               Left            =   90
               LinesPerRow     =   1
               MarqueeUnique   =   -1  'True
               SplitPropsGlobal=   -1  'True
               SplitTabMode    =   0  'Don't tab across splits
               TabCapture      =   0   'False
               TabIndex        =   19
               Top             =   90
               UseBookmarks    =   -1  'True
               Width           =   9000
               WrapCellPointer =   0   'False
            End
         End
      End
   End
   Begin Label lblMsg
      Caption         =   "Label1"
      Height          =   255
      Left            =   3300
      TabIndex        =   20
      Top             =   60
      Width           =   1875
   End
End
Option Explicit

Dim lSave As Integer

Sub Form_Activate ()
    activateToolBar Tag
    setSave lSave
End Sub

Sub Form_Load ()
    Dim cLay As String
    lSave = False
    activateToolBar Tag
    setSave lSave

    cLay = loadGridSetup(Me.Tag)
    If cLay <> "" Then tbl<<formname>>.Layout = cLay
    dtaCtr.DatabaseName = gcMainPath + APPLICATION_DB
    dtaCtr.Refresh

End Sub

Sub Form_QueryUnload (Cancel As Integer, UnloadMode As Integer)
    If lSave Then
        If Not yesno("Changes will be lost.  Close anyway?", "Close") Then
            Exit Sub
        Else
            Cancel = True
        End If
    End If
End Sub

Sub Form_Unload (Cancel As Integer)
    deactivateToolBar
    saveGridSetup (Me.Tag), (tbl<<formname>>.Layout)
End Sub



Sub lblMsg_Change ()
    On Error GoTo cantMove
    Select Case lblMsg.Caption
        Case ""
            ' do nothing
            Exit Sub

        Case MSG_ADD
            lSave = True
            setSave True
            dtaCtr.Recordset.AddNew
            tab<<formname>>.CurrTab = 1

        Case MSG_EDIT
            lSave = True
            setSave True

            dtaCtr.Recordset.Edit
            tab<<formname>>.CurrTab = 1

        Case MSG_DELETE
            ' todo:  needs integrity check
            If yesno("Are you sure you want to delete the current record?", "Delete") Then
                dtaCtr.Recordset.Delete
            End If

        Case MSG_CANCEL
            lSave = False
            setSave False
            dtaCtr.Recordset.Edit
            dtaCtr.Recordset.Update

        Case MSG_SAVE
            lSave = False
            setSave False
            dtaCtr.Recordset.Update
            dtaCtr.Recordset.Bookmark = dtaCtr.Recordset.LastModified

        Case MSG_REFRESH
            dtaCtr.Refresh

        Case MSG_PRINT


        Case MSG_CLOSE
            lblMsg.Caption = "" ' must do this first or doing it later will reload the form
            Unload Me
            Exit Sub

        Case MSG_MOV_FIRST
            dtaCtr.Recordset.MoveFirst

        Case MSG_MOV_PREV
            dtaCtr.Recordset.MovePrevious
            If dtaCtr.Recordset.BOF Then
                dtaCtr.Recordset.MoveFirst
                Beep
            End If

        Case MSG_MOV_NEXT
            dtaCtr.Recordset.MoveNext
            If dtaCtr.Recordset.EOF Then
                dtaCtr.Recordset.MoveLast
                Beep
            End If

        Case MSG_MOV_LAST
            dtaCtr.Recordset.MoveLast

    End Select

    lblMsg.Caption = ""

    'bOk(0).Enabled = False
    Exit Sub

cantMove:
    ErrorMsg "Unable to move records: " & Error$
    Exit Sub

End Sub

Sub tab<<formname>>_Switch (OldTab As Integer, NewTab As Integer, Cancel As Integer)
    If lSave And NewTab = 0 Then Cancel = True
End Sub